home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jentrykeys.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  7.6 KB  |  285 lines
  1. # jentrykeys.tcl - support for Entry key bindings
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6.  
  7. ######################################################################
  8. # j:ekb:mkmap w map next {{key command ?args?}...} - set up pseudo-binding
  9. #   Note that key includes modifier; w can be particular widget or class
  10. ######################################################################
  11.  
  12. proc j:ekb:mkmap { w map next bindings } {
  13.   global j_teb
  14.   
  15.   foreach list $bindings {
  16.     set key [lindex $list 0]
  17.     set command [lreplace $list 0 0]
  18.     
  19.     set j_teb(ekm,$w,$map,$key) $command
  20.     set j_teb(ekm_next,$w,$map) $next
  21.   }
  22. }
  23.  
  24. ######################################################################
  25. # j:ekb:process_key W mod K A - process keystrokes
  26. ######################################################################
  27.  
  28. proc j:ekb:process_key {W mod K A} {
  29.   global j_teb
  30.   
  31.   set j_teb(next_keymap,$W) ""        ;# some bindings change this
  32.   
  33.   if {"x$mod" != "x"} {
  34.     set K "$mod-$K"
  35.     set default "$mod-DEFAULT"
  36.   } else {
  37.     set default "DEFAULT"
  38.   }
  39.   
  40.   # if this widget hasn't been used before, set its keymap from default
  41.   if {! [info exists j_teb(keymap,$W)]} {
  42.     set j_teb(keymap,$W) $j_teb(keymap,Entry)
  43.   }
  44.   # if no last command, set it to {}
  45.   if {! [info exists j_teb(last_command,$W)]} {
  46.     set j_teb(last_command,$W) {}
  47.   }
  48.   set map $j_teb(keymap,$W)
  49.  
  50.   if [info exists j_teb(ekm,$W,$map,$K)] {
  51.     # specific action for this widget
  52.     set command $j_teb(ekm,$W,$map,$K)
  53.     eval $command [list $W $K $A]
  54.   } else {
  55.     if [info exists j_teb(ekm,Entry,$map,$K)] {
  56.       # specific binding for all Entry widgets
  57.       set command $j_teb(ekm,Entry,$map,$K)
  58.       eval $command [list $W $K $A]
  59.     } else {
  60.       if [info exists j_teb(ekm,$W,$map,$default)] {
  61.         # default key action for this widget
  62.         set command $j_teb(ekm,$W,$map,$default)
  63.         eval $command [list $W $K $A]
  64.       } else {
  65.         # default key action for Entry widgets
  66.         set command $j_teb(ekm,Entry,$map,$default)
  67.         eval $command [list $W $K $A]
  68.       }
  69.     }
  70.   }
  71.   set j_teb(last_command,$W) $command
  72.   
  73.   # if a binding hasn't explicitly chosen a different keymap for the next
  74.   #   key, switch to the default next keymap for this keymap:
  75.   if {"x$j_teb(next_keymap,$W)" == "x"} {
  76.     if [info exists j_teb(ekm_next,$W,$map)] {
  77.       set j_teb(next_keymap,$W) $j_teb(ekm_next,$W,$map)
  78.     } else {
  79.       set j_teb(next_keymap,$W) $j_teb(ekm_next,Entry,$map)
  80.     }
  81.   }
  82.   set j_teb(keymap,$W) $j_teb(next_keymap,$W)
  83. }
  84.  
  85. ######################################################################
  86. # j:ek:see_insert W - make sure insert point is visible
  87. ######################################################################
  88.  
  89. proc j:ek:see_insert { W } {
  90.   j:tk3 {tk_entrySeeCaret $W}
  91.   j:tk4 {tkEntrySeeInsert $W}
  92. }
  93.  
  94. ######################################################################
  95. # j:ekb:new_mode mode W K A - change modes
  96. ######################################################################
  97.  
  98. proc j:ekb:new_mode { mode W K A } {
  99.   global j_teb
  100.   set j_teb(next_keymap,$W) $mode
  101. }
  102.  
  103. ######################################################################
  104. # j:ekb:self_insert W K A - insert A into entry widget W
  105. # * handles deletion of selection if needed
  106. ######################################################################
  107.  
  108. proc j:ekb:self_insert { W K A } {
  109.   global j_teb J_PREFS
  110.   
  111.   if $J_PREFS(typeover) {
  112.     catch {
  113.       $W delete sel.first sel.last
  114.     }
  115.   }
  116.  
  117.   if {"$A" != ""} {
  118.     $W insert insert $A
  119.     j:ek:see_insert $W
  120.   }
  121. }
  122.  
  123. ######################################################################
  124. # j:ekb:clear_and_insert W K A - clear entry widget W and insert A
  125. ######################################################################
  126.  
  127. proc j:ekb:clear_and_insert { W K A } {
  128.   global j_teb
  129.   puts stdout foo
  130.   
  131.   $W delete 0 end
  132.   
  133.   if {"$A" != ""} {
  134.     $W insert insert $A
  135.     j:ek:see_insert $W
  136.   }
  137. }
  138.  
  139. ######################################################################
  140. ### ENTRY MOVEMENT ROUTINES
  141. ######################################################################
  142.  
  143. # j:ekb:left W - move one character left
  144. proc j:ekb:left { W args } {
  145.   $W icursor [expr {[$W index insert] - 1}]
  146.   j:ek:see_insert $W
  147. }
  148.  
  149. # j:ekb:right W - move one character right
  150. proc j:ekb:right { W args } {
  151.   $W icursor [expr {[$W index insert] + 1}]
  152.   j:ek:see_insert $W
  153. }
  154.  
  155. # j:ekb:bol W - move to beginning of entry
  156. proc j:ekb:bol { W args } {
  157.   $W icursor 0
  158.   j:ek:see_insert $W
  159. }
  160.  
  161. # j:ekb:eol W - move to end of entry
  162. proc j:ekb:eol { W args } {
  163.   $W icursor end
  164.   j:ek:see_insert $W
  165. }
  166.  
  167. # j:ekb:word_left W - move one word left
  168. # hacked from tk_entryBackword in entry.tcl
  169. proc j:ekb:word_left { W args } {
  170.   set string [$W get]
  171.   set length [string length $string]
  172.   set curs [expr [$W index insert]-2]
  173.   if {$curs < 0} return
  174.   for {set start $curs} {$start > 0} {incr start -1} {
  175.     if {[string first [string index $string $start] " \t"] >= 0} {
  176.       incr start
  177.       break
  178.     }
  179.     if {([string first [string index $string $start] " \t"] < 0)
  180.         && ([string first [string index $string [expr $start-1]] " \t"]
  181.         >= 0)} {
  182.       break
  183.     }
  184.   }
  185.   $W icursor $start
  186.   j:ek:see_insert $W
  187. }
  188.  
  189. # j:ekb:word_right W - move one word right
  190. # hacked from tk_entryBackword in entry.tcl
  191. proc j:ekb:word_right { W args } {
  192.   set string [$W get]
  193.   set length [string length $string]
  194.   set curs [expr [$W index insert]+1]
  195.  
  196.   for {set end $curs} {$end < $length} {incr end 1} {
  197.     if {[string first [string index $string $end] " \t"] >= 0} {
  198.       break
  199.     }
  200.   }
  201.   $W icursor $end
  202.   j:ek:see_insert $W
  203. }
  204.  
  205. ######################################################################
  206. ###  ENTRY DELETION ROUTINES
  207. ######################################################################
  208.  
  209. # j:ekb:clear W - clear entire widget
  210. proc j:ekb:clear { W args } {
  211.   $W delete 0 end
  212. }
  213.  
  214. # j:ekb:delete_left W - delete character before insert
  215. proc j:ekb:delete_left { W args } {
  216.   global J_PREFS
  217.   
  218.   if {$J_PREFS(typeover) && ![catch {selection get} s]} {
  219.     if {"x[selection own]" == "x$W"} {
  220.       $W delete sel.first sel.last
  221.       return 0
  222.     }
  223.   }
  224.   tk_entryBackspace $W
  225.   j:ek:see_insert $W
  226. }
  227.  
  228. # j:ekb:delete_right W - delete character after insert
  229. proc j:ekb:delete_right { W args } {
  230.   global J_PREFS
  231.   
  232.   if {$J_PREFS(typeover) && ![catch {selection get} s]} {
  233.     if {"x[selection own]" == "x$W"} {
  234.       $W delete sel.first sel.last
  235.       return 0
  236.     }
  237.   }
  238.   $W delete insert
  239.   j:ek:see_insert $W
  240. }
  241.  
  242. # j:ekb:kill_eol W - delete to eol
  243. proc j:ekb:kill_eol { W args } {
  244.   $W delete insert end
  245. }
  246.  
  247. # j:ekb:kill_selection W - delete selection
  248. proc j:ekb:kill_selection { W args } {
  249.   catch {
  250.     $W delete sel.first sel.last
  251.   }
  252. }
  253.  
  254. # j:ekb:delete_word_left W - move one word left
  255. # hacked from tk_entryBackword in entry.tcl
  256. proc j:ekb:delete_word_left { W args } {
  257.   set string [$W get]
  258.   set length [string length $string]
  259.   set curs [expr [$W index insert]-2]
  260.   if {$curs < 0} return
  261.   for {set start $curs} {$start > 0} {incr start -1} {
  262.     if {[string first [string index $string [expr $start-1]] " \t"] >= 0} {
  263.       break
  264.     }
  265.   }
  266.   $W delete $start [expr {$curs+1}]
  267.   j:ek:see_insert $W
  268. }
  269.  
  270. # j:ekb:delete_word_right W - move one word right
  271. # hacked from tk_entryBackword in entry.tcl
  272. proc j:ekb:delete_word_right { W args } {
  273.   set string [$W get]
  274.   set length [string length $string]
  275.   set curs [expr [$W index insert]+1]
  276.  
  277.   for {set end $curs} {$end < $length} {incr end 1} {
  278.     if {[string first [string index $string [expr $end+1]] " \t"] >= 0} {
  279.       break
  280.     }
  281.   }
  282.   $W delete insert $end
  283.   j:ek:see_insert $W
  284. }
  285.